home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / POTENT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  5.9 KB  |  235 lines
  1. 10  'POTENT - Custome Potentiometer - 5 FEB 91 rev. 29 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  PROG$="potent"
  4. 40  COMMON EX$,PROG$,R,E    'for chaining to PRECIRES
  5. 50  CLS
  6. 60  COLOR 7,0,1
  7. 70  DIM SR(12)           'shaft rotation
  8. 80  UL$=STRING$(80,205)  'underline
  9. 90  ER$=STRING$(80,32)   'erase
  10. 100  U1$="######,###"
  11. 110  U3$="#####,###"
  12. 120  O$=" -"
  13. 130  '
  14. 140  '.....start
  15. 150  CLS
  16. 160  COLOR 15,2
  17. 170  PRINT " CUSTOM POTENTIOMETER";TAB(57);"by George Murphy VE3ERP ";
  18. 180  COLOR 1,0:PRINT STRING$(80,"<0xDF!>");
  19. 190  COLOR 7,0
  20. 200  '
  21. 210  '.....preface
  22. 220  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  23. 230  GOSUB 1730    'text
  24. 240  PRINT
  25. 250  COLOR 0,7:LOCATE CSRLIN,22
  26. 260  PRINT " Press 1 to continue or 0 to EXIT.....";
  27. 270  COLOR 7,0
  28. 280  Z$=INKEY$:IF Z$=""THEN 280
  29. 290  IF Z$="0"THEN CLS:RUN EX$
  30. 300  IF Z$="1"THEN 330
  31. 310  GOTO 280
  32. 320  '
  33. 330  '.....diagram
  34. 340  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  35. 350  LOCATE 10,56:PRINT "VARPTRDEFDBL SOUNDSOUNDSOUNDCOLOR
  36. 360  LOCATE 11,56:PRINT "CALL     CALL
  37. 370  LOCATE 12,56:PRINT "CALL     BLOADSOUNDSOUNDSOUNDCOLOR
  38. 380  LOCATE 13,56:PRINT "CALL     CALL   CALL
  39. 390  LOCATE 14,56:PRINT "   VARPTRSOUNDDEFDBLR1  R2
  40. 400  LOCATE 15,56:PRINT "CALL  CLSSOUNDSOUND<0xB4!>   CALL
  41. 410  LOCATE 16,56:PRINT "CALL     BLOADSOUNDSOUNDSOUND'
  42. 420  LOCATE 17,56:PRINT "CALL     CALL
  43. 430  LOCATE 18,56:PRINT "CLSDEFDBL SOUNDSOUNDSOUND'
  44. 440  COLOR 0,7:LOCATE 14,55:PRINT " R ":COLOR 7,0      'hi-lite R
  45. 450  '
  46. 460  '.....inputs
  47. 470  LOCATE 3
  48. 480  PRINT"ENTER: Desired custom full scale resistance (ohms).............R  =";
  49. 490  INPUT R
  50. 500  IF R=0 THEN LOCATE CSRLIN-1:PRINT ER$;:GOTO 470
  51. 510  LOCATE CSRLIN-1:PRINT STRING$(6,32)
  52. 520  LOCATE CSRLIN-1,68:COLOR 0,7:PRINT USING U1$;R;:PRINT O$:COLOR 7,0
  53. 530  PRINT"ENTER: Value of a standard linear pot greater than R...........R1 =";
  54. 540  INPUT R1
  55. 550  IF R1<R THEN LOCATE CSRLIN-1:PRINT ER$;:LOCATE CSRLIN-1:GOTO 530
  56. 560  LOCATE CSRLIN-1:PRINT STRING$(6,32)
  57. 570  LOCATE CSRLIN-1,68:PRINT USING U1$;R1;:PRINT O$
  58. 580  Y=CSRLIN
  59. 590  LOCATE 14,62:COLOR 0,7:PRINT "R1":COLOR 7,0
  60. 600  LOCATE Y
  61. 610  IF R1=R THEN LOCATE CSRLIN-1:GOTO 530
  62. 620  R2=R*R1/(R1-R)         'parallel resistor
  63. 630  R2=INT(R2+0.5)
  64. 640  '
  65. 650  '.....display results
  66. 660  PRINT "       Value of parallel resistance for full scale rotation....R2 =";
  67. 670  PRINT USING U1$;R2;:PRINT O$
  68. 680  COLOR 0,7
  69. 690  Y=CSRLIN
  70. 700  LOCATE 14,65:PRINT" R2=";:PRINT USING U3$;R2;:PRINT O$
  71. 710  LOCATE Y
  72. 720  COLOR 7,0
  73. 730  PRINT UL$;
  74. 740  '
  75. 750  LOCATE CSRLIN-1,28:PRINT "<0xCB!>";
  76. 760  LOCATE CSRLIN,54:PRINT "<0xCB!>"
  77. 770  PRINT " Rotation";
  78. 780  PRINT TAB(14);"R1";O$;
  79. 790  PRINT TAB(25);"R";O$;
  80. 800  PRINT TAB(28);"OPEN0DEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND R SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLmaxOPEN";
  81. 810  COLOR 0,7
  82. 820  LOCATE CSRLIN,56:PRINT " R1 is a";USING U1$;R1;:PRINT ;O$;"    ";
  83. 830  COLOR 7,0
  84. 840  PRINT STRING$(53,"THEN")
  85. 850  LOCATE CSRLIN-1,28:PRINT "LOCATE";
  86. 860  LOCATE CSRLIN,54:PRINT "RANDOMIZE";
  87. 870  COLOR 0,7
  88. 880  LOCATE CSRLIN,56:PRINT " lin.taper potentiometer"
  89. 890  COLOR 7,0
  90. 900  '
  91. 910  '.....shaft rotation
  92. 920   FOR Z=1 TO 10
  93. 930    SR(Z)=Z*10                           '% shaft rotation
  94. 940   NEXT Z
  95. 950  MAX=R1*R2/(R1+R2)                      'value of R at 100% rotation
  96. 960  G=1/((R2/(R/2)-1)/R2)                  'value of r1 at 1/2 R
  97. 970  GG=G/R1*100:SR(11)=GG                  '% shaft rotation for R/2
  98. 980  '
  99. 990  '.....calculate rotation & display
  100. 1000     FOR Z=1 TO 10
  101. 1010  IF Z=10 THEN COLOR 15
  102. 1020  PRINT USING "###.#";SR(Z);:PRINT " %";         '% rotation
  103. 1030  COLOR 7,0
  104. 1040  C=SR(Z)*R1/100                                 'value of R1
  105. 1050  D=C*R2/(C+R2)                                  'value of R
  106. 1060  PRINT USING U1$;C;
  107. 1070  IF Z=10 THEN COLOR 15
  108. 1080  PRINT USING U1$;D;
  109. 1090  COLOR 7,0
  110. 1100  PRINT "    ";
  111. 1110  '
  112. 1120  '.....bar chart
  113. 1130  B=CINT(25*D/R)
  114. 1140  LOCATE CSRLIN,29
  115. 1150  COLOR 4:PRINT STRING$(B,"CSRLIN");
  116. 1160  IF Z=10 THEN LOCATE CSRLIN,30:COLOR 14,4:PRINT "= R";
  117. 1170  COLOR 7,0
  118. 1180  LOCATE CSRLIN,54
  119. 1190  PRINT "OPEN"
  120. 1200     NEXT Z
  121. 1210  '
  122. 1220  PRINT STRING$(53,196);"<0xB6!>"
  123. 1230  PRINT USING "###.#";GG;
  124. 1240  PRINT " %";:PRINT USING U1$;G;R/2;
  125. 1250  PRINT " ";:COLOR 14,4
  126. 1260  PRINT " = RENUMR ";:COLOR 7,0:PRINT " *(See Notes) ":
  127. 1270  '
  128. 1280  COLOR 7,0:LOCATE CSRLIN-1,54:PRINT "OPEN"
  129. 1290  PRINT UL$;
  130. 1300  LOCATE CSRLIN-1,54:PRINT "LOCATE"
  131. 1310  COLOR 0,7
  132. 1320  PRINT " * NOTES:";
  133. 1330  COLOR 7,0
  134. 1340  PRINT" The resistance curve of the customized potentiometer is not linear."
  135. 1350  PRINT" A precision parallel resistor (R2) will be designed for you ";
  136. 1360  PRINT"when you EXIT."
  137. 1370  GOSUB 2220
  138. 1380  LOCATE 25,1:PRINT ER$;:LOCATE 25,11
  139. 1390  COLOR 15,1
  140. 1400  PRINT " Do you want to calculate current through R1 & R2 ?  (y/n) ";
  141. 1410  COLOR 7,0
  142. 1420  Z$=INKEY$
  143. 1430  IF Z$="n"THEN E=-1:GOTO 2190
  144. 1440  IF Z$="y"THEN 1470
  145. 1450  GOTO 1420
  146. 1460  '
  147. 1470  '.....calculate current
  148. 1480  LOCATE 24,1:PRINT ER$;
  149. 1490  LOCATE 25,1:PRINT ER$;
  150. 1500  COLOR 0,7
  151. 1510  LOCATE 19,1:INPUT " ENTER: Voltage across R ";E
  152. 1520  COLOR 7,0
  153. 1530  LOCATE 19,1:PRINT STRING$(50,196)
  154. 1540  LOCATE 24,2
  155. 1550  PRINT "Currents shown above are in ma. for a voltage drop across R of";
  156. 1560  COLOR 0,7:PRINT E;"volts ";
  157. 1570  COLOR 7,0
  158. 1580  LOCATE 7,29:PRINT STRING$(24,32)
  159. 1590  LOCATE 7,32:PRINT "  I(R1)+ I(R2)= I(R)  "
  160. 1600  '
  161. 1610  FOR Z=1 TO 10
  162. 1620  LOCATE Z+8,29
  163. 1630  PRINT STRING$(22,32):LOCATE CSRLIN-1,32
  164. 1640  C=SR(Z)*R1/100
  165. 1650  D=C*R2/(C+R2)
  166. 1660  PRINT USING "#####.#";E/C*10^3;
  167. 1670  PRINT USING "####.#";E/R2*10^3;
  168. 1680  PRINT USING "#####.#";E/D*10^3;
  169. 1690  PRINT "  "
  170. 1700  NEXT Z
  171. 1710  GOTO 2180
  172. 1720  '
  173. 1730  '.....preface
  174. 1740  T=8
  175. 1750  PRINT TAB(T);
  176. 1760  PRINT "   The resistance curve of this custom potentiometer is not linear."
  177. 1770  PRINT TAB(T);
  178. 1780  PRINT "It has a taper approximately as shown in the block graph on the"
  179. 1790  PRINT TAB(T);
  180. 1800  PRINT "screen display."
  181. 1810  PRINT TAB(T);
  182. 1820  PRINT "   Choose a standard potentiometer as close as possible to the"
  183. 1830  PRINT TAB(T);
  184. 1840  PRINT "custom full scale value you have specified. The closer the standard"
  185. 1850  PRINT TAB(T);
  186. 1860  PRINT "potentiometer is to the specified custom value the more linear will"
  187. 1870  PRINT TAB(T);
  188. 1880  PRINT "be the resistance curve.
  189. 1890  PRINT TAB(T);
  190. 1900  PRINT "   If the value of the standard potentiometer is far removed from"
  191. 1910  PRINT TAB(T);
  192. 1920  PRINT "the specified custom value then part of the custom range will be"
  193. 1930  PRINT TAB(T);
  194. 1940  PRINT "crowded near one end of the shaft rotation."
  195. 1950  PRINT TAB(T);
  196. 1960  PRINT "   You may want to experiment with ";CHR$(34);"far removed";
  197. 1970  PRINT CHR$(34);" audio taper"
  198. 1980  PRINT TAB(T);
  199. 1990  PRINT "potentiometers. If you get lucky you could end up with a near"
  200. 2000  PRINT TAB(T);
  201. 2010  PRINT "linear resistance curve even if the rotation may be in the wrong"
  202. 2020  PRINT TAB(T);
  203. 2030  PRINT "direction. Who cares? If you weren't an experimenter you wouldn't"
  204. 2040  PRINT TAB(T);
  205. 2050  PRINT "be messing about with this anyway."
  206. 2060  PRINT TAB(T);
  207. 2070  PRINT "   The custom potentiometer consists of a linear potentiometer in"
  208. 2080  PRINT TAB(T);
  209. 2090  PRINT "parallel with a fixed bridging resistance. When you exit the"
  210. 2100  PRINT TAB(T);
  211. 2110  PRINT "program the final screen display will show how two standard"
  212. 2120  PRINT TAB(T);
  213. 2130  PRINT "resistors in parallel will provide a bridging resistor within"
  214. 2140  PRINT TAB(T);
  215. 2150  PRINT "about 1% of the required bridge resistance."
  216. 2160  RETURN
  217. 2170  '
  218. 2180  GOSUB 2220
  219. 2190  CLS:R=R2
  220. 2200  CHAIN"precires"     'precision resistor program
  221. 2210  '
  222. 2220  'HARDCOPY
  223. 2230  GOSUB 2340:LOCATE 25,2:COLOR 14,6
  224. 2240  PRINT " Press 1 to print screen, 2 to print screen & ";
  225. 2250  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  226. 2260  Z$=INKEY$:IF Z$="3"THEN GOSUB 2340:RETURN
  227. 2270  IF Z$="1"OR Z$="2"THEN GOSUB 2340:GOTO 2290
  228. 2280  GOTO 2260
  229. 2290  FOR QX=1 TO 24:FOR QY=1 TO 80
  230. 2300  LPRINT CHR$(SCREEN(QX,QY));
  231. 2310  NEXT QY:NEXT QX
  232. 2320  IF Z$="2"THEN LPRINT CHR$(12)
  233. 2330  GOTO 2230
  234. 2340  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  235.